home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / COMM / ASYNCTIM / TIMTEST.ZIP / AsyncTimerTest1.pas < prev   
Pascal/Delphi Source File  |  1996-06-18  |  2KB  |  87 lines
  1. unit AsyncTimerTest1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   AsyncTimer, StdCtrls, ComCtrls;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     AsyncTimer: TAsyncTimer;
  12.     TrackBarRInterval: TTrackBar;
  13.     Label2: TLabel;
  14.     Label3: TLabel;
  15.     Label4: TLabel;
  16.     Label5: TLabel;
  17.     cbEnabled: TCheckBox;
  18.     lblActualInterval: TLabel;
  19.     lblReqInterval: TLabel;
  20.     Label1: TLabel;
  21.     lblTimingFaults: TLabel;
  22.     procedure AsyncTimerTimer(Sender: TObject);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure cbEnabledClick(Sender: TObject);
  25.     procedure TrackBarRIntervalChange(Sender: TObject);
  26.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  27.     procedure AsyncTimerTimingFault(Sender: TObject);
  28.   private
  29.     FBusy :boolean;
  30.     FtimingFaults :Integer;
  31.   public
  32.     { Public declarations }
  33.   end;
  34.  
  35. var
  36.   MainForm: TMainForm;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. var LastEvent :Longint = 0;
  43.  
  44. procedure TMainForm.AsyncTimerTimer(Sender: TObject);
  45. var T :Longint;
  46. begin
  47.  T := GetTickCount;
  48.  if not FBusy then
  49.    begin
  50.     FBusy := true;
  51.     if LastEvent <> 0 then lblActualInterval.Caption := IntToStr( T - LastEvent );
  52.     FBusy := false;
  53.    end;
  54.   LastEvent := T;
  55. end;
  56.  
  57. procedure TMainForm.FormCreate(Sender: TObject);
  58. begin
  59.  FBusy := false;
  60.  TrackBarRInterval.Position := AsyncTimer.Interval;
  61.  cbEnabled.Checked := AsyncTimer.Enabled;
  62. end;
  63.  
  64. procedure TMainForm.cbEnabledClick(Sender: TObject);
  65. begin
  66.  AsyncTimer.Enabled := TCheckBox( Sender ).Checked;
  67. end;
  68.  
  69. procedure TMainForm.TrackBarRIntervalChange(Sender: TObject);
  70. begin
  71.   AsyncTimer.Interval := TrackBarRInterval.Position;
  72.   lblReqInterval.Caption := IntToStr( TrackBarRInterval.Position );
  73. end;
  74.  
  75. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  76. begin
  77.  AsyncTimer.Enabled := false;
  78. end;
  79.  
  80. procedure TMainForm.AsyncTimerTimingFault(Sender: TObject);
  81. begin
  82.  inc( FTimingFaults );
  83.  lblTimingFaults.Caption := IntToStr( FTimingFaults );
  84. end;
  85.  
  86. end.
  87.